home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE16 / SOLVER / SOLVER.ZIP / TESTC1.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-08-23  |  2.5 KB  |  119 lines

  1. {
  2.  
  3. Demonstration program for the TSolver component
  4.  
  5. Shows:
  6.   - user-edited expressions
  7.   - ParseAndSolve method
  8.   - user-defined functions
  9.       - no arguments
  10.       - fixed number of arguments
  11.       - variable number of arguments
  12.   - how to display results
  13.   - how to display error messages and locations
  14.  
  15. }
  16.  
  17. unit Testc1;
  18.  
  19. interface
  20.  
  21. uses
  22.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  23.   Forms, Dialogs, solver, StdCtrls, ExtCtrls, Gauges;
  24.  
  25. type
  26.   TForm1 = class(TForm)
  27.     Solver1: TSolver;
  28.     EquMemo: TMemo;
  29.     ResultMemo: TMemo;
  30.     btnSolve: TButton;
  31.     pnlError: TPanel;
  32.     procedure btnSolveClick(Sender: TObject);
  33.     procedure Solver1FunctionCall(Sender: TObject; index: Integer;
  34.       params: PRealArray; NumParams: Integer; var OK: Boolean;
  35.       var result: Double);
  36.   private
  37.     { Private declarations }
  38.     procedure DisplayError;
  39.   public
  40.     { Public declarations }
  41.   end;
  42.  
  43. var
  44.   Form1: TForm1;
  45.  
  46. implementation
  47.  
  48. {$R *.DFM}
  49.  
  50. function LineToOffset(memo: TMemo; line: integer): integer;
  51. var i: integer;
  52. begin
  53.   result:=0;
  54.   if line >= memo.lines.count then
  55.     result:=memo.GetTextLen else
  56.   for i:=1 to line do
  57.     inc(result,length(memo.lines.strings[i-1])+2);
  58. end;
  59.  
  60. procedure TForm1.btnSolveClick(Sender: TObject);
  61. var i: integer;
  62. begin
  63.   pnlError.Caption:='';
  64.   with Solver1 do
  65.   begin
  66.     Equations.Assign(EquMemo.Lines);
  67.     ResultMemo.Clear;
  68.     ExpressionsOnly:=true;
  69.     if ParseAndSolve then
  70.     begin
  71.       for i:=0 to NumVariables-1 do
  72.         if Known[i] then
  73.           ResultMemo.Lines.Add(Format('%6.4f', [Value[i]])) else
  74.           ResultMemo.Lines.Add('');
  75.     end else
  76.       DisplayError;
  77.   end;
  78. end;
  79.  
  80. procedure TForm1.DisplayError;
  81. var p: TPoint;
  82. begin
  83.   p:=Solver1.ErrorPos;
  84.   if p.x < 0 then p.x:=0;
  85.   if p.y >= 0 then
  86.   begin
  87.     EquMemo.SelStart:=LineToOffset(EquMemo,p.y)+p.x;
  88.     EquMemo.SelLength:=0;
  89.   end;
  90.   EquMemo.SetFocus;
  91.   pnlError.Caption:=Solver1.ErrorString;
  92.   Messagebeep($FFFF);
  93. end;
  94.  
  95. procedure TForm1.Solver1FunctionCall(Sender: TObject; index: Integer;
  96.   params: PRealArray; NumParams: Integer; var OK: Boolean;
  97.   var result: Double);
  98. var i: integer;
  99. begin
  100.   case index of
  101.     0: begin
  102.          result:=5;
  103.        end;
  104.     1: begin
  105.          result:=0;
  106.          for i:=1 to NumParams do
  107.            result:=result+params^[i];
  108.        end;
  109.     2: begin
  110.          result:=1;
  111.          for i:=1 to NumParams do
  112.            result:=result*params^[i];
  113.        end;
  114.   end;
  115. end;
  116.  
  117. end.
  118.  
  119.